home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / lib / perl5 / metaclass.pm < prev    next >
Encoding:
Perl POD Document  |  2010-07-25  |  2.5 KB  |  110 lines

  1.  
  2. package metaclass;
  3.  
  4. use strict;
  5. use warnings;
  6.  
  7. use Carp         'confess';
  8. use Scalar::Util 'blessed';
  9.  
  10. our $VERSION   = '1.04';
  11. $VERSION = eval $VERSION;
  12. our $AUTHORITY = 'cpan:STEVAN';
  13.  
  14. use Class::MOP;
  15.  
  16. sub import {
  17.     my ( $class, @args ) = @_;
  18.  
  19.     unshift @args, "metaclass" if @args % 2 == 1;
  20.     my %options = @args;
  21.  
  22.     my $metaclass = delete $options{metaclass};
  23.  
  24.     unless ( defined $metaclass ) {
  25.         $metaclass = "Class::MOP::Class";
  26.     } else {
  27.         Class::MOP::load_class($metaclass);
  28.     }
  29.  
  30.     ($metaclass->isa('Class::MOP::Class'))
  31.         || confess "The metaclass ($metaclass) must be derived from Class::MOP::Class";
  32.  
  33.     # make sure the custom metaclasses get loaded
  34.     foreach my $key (grep { /_(?:meta)?class$/ } keys %options) {
  35.         unless ( ref( my $class = $options{$key} ) ) {
  36.             Class::MOP::load_class($class)
  37.         }
  38.     }
  39.  
  40.     my $package = caller();
  41.  
  42.     # create a meta object so we can install &meta
  43.     my $meta = $metaclass->initialize($package => %options);
  44.     $meta->add_method('meta' => sub {
  45.         # we must re-initialize so that it
  46.         # works as expected in subclasses,
  47.         # since metaclass instances are
  48.         # singletons, this is not really a
  49.         # big deal anyway.
  50.         $metaclass->initialize((blessed($_[0]) || $_[0]) => %options)
  51.     });
  52. }
  53.  
  54. 1;
  55.  
  56. __END__
  57.  
  58. =pod
  59.  
  60. =head1 NAME
  61.  
  62. metaclass - a pragma for installing and using Class::MOP metaclasses
  63.  
  64. =head1 SYNOPSIS
  65.  
  66.   package MyClass;
  67.  
  68.   # use Class::MOP::Class
  69.   use metaclass;
  70.  
  71.   # ... or use a custom metaclass
  72.   use metaclass 'MyMetaClass';
  73.  
  74.   # ... or use a custom metaclass
  75.   # and custom attribute and method
  76.   # metaclasses
  77.   use metaclass 'MyMetaClass' => (
  78.       'attribute_metaclass' => 'MyAttributeMetaClass',
  79.       'method_metaclass'    => 'MyMethodMetaClass',
  80.   );
  81.  
  82.   # ... or just specify custom attribute
  83.   # and method classes, and Class::MOP::Class
  84.   # is the assumed metaclass
  85.   use metaclass (
  86.       'attribute_metaclass' => 'MyAttributeMetaClass',
  87.       'method_metaclass'    => 'MyMethodMetaClass',
  88.   );
  89.  
  90. =head1 DESCRIPTION
  91.  
  92. This is a pragma to make it easier to use a specific metaclass
  93. and a set of custom attribute and method metaclasses. It also
  94. installs a C<meta> method to your class as well.
  95.  
  96. =head1 AUTHORS
  97.  
  98. Stevan Little E<lt>stevan@iinteractive.comE<gt>
  99.  
  100. =head1 COPYRIGHT AND LICENSE
  101.  
  102. Copyright 2006-2010 by Infinity Interactive, Inc.
  103.  
  104. L<http://www.iinteractive.com>
  105.  
  106. This library is free software; you can redistribute it and/or modify
  107. it under the same terms as Perl itself.
  108.  
  109. =cut
  110.